partidos_interes <- c("PSOE", "EAJ-PNV", "ERC", "EH-BILDU", "PP", "PODEMOS", "CS", "BNG", "VOX", "IU", "PCE", "ICV", "EH", "EA")
col_inicio_partidos <- 11 #Es la primera columna donde aparecen los partidos, las columnas de antes son identificadores fechas y demás.
columnas_otros <- setdiff(names(surveys_filtered)[col_inicio_partidos:ncol(surveys_filtered)], partidos_interes) #setdiff te dice los elementos distintos de los dos datasets que le pases. En este caso estan por un lado los partidos de interes y por otro lado todos, los elementos distintos son los partidos que no coinciden y que van a ir a la categoria otros.
surveys_filtered <- surveys_filtered |>
mutate(
`EH-BILDU` = rowSums(across(c("EH-BILDU", "EH", "EA"), ~replace_na(., 0)), na.rm = TRUE), # Suma de columnas específicas
PODEMOS = rowSums(across(c("IU","PCE", "ICV"), ~replace_na(., 0)), na.rm = TRUE),
OTROS = rowSums(across(all_of(columnas_otros), ~ replace_na(., 0)), na.rm = TRUE) #Se crea una nueva columna llamada OTROS, que contiene la suma de los valores de todas las columnas que no pertenecen a los partidos de interés.
) |>
select(all_of(partidos_interes), OTROS, everything()) |> select(1:20) #all_of(partidos_interes) selecciona y coloca al principio las columnas correspondientes a los partidos de interés. Luego, se agrega la variable creada OTROS y everything() selecciona todas las demás columnas que no han sido mencionadas, manteniendo su orden original.# A tibble: 1,523 × 20
PSOE `EAJ-PNV` ERC `EH-BILDU` PP PODEMOS CS BNG VOX IU PCE
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 43 6 5 0 39 3 NA NA NA 3 NA
2 42.6 6 5 0 38.6 4 NA NA NA 4 NA
3 42.4 6 5 0 39 4 NA NA NA 4 NA
4 44.1 NA 4 0 38 5.2 NA NA NA 5.2 NA
5 44.3 NA NA 0 38 0 NA NA NA NA NA
6 43.4 1.5 1.9 0 39.3 4.4 NA 0.6 NA 4.4 NA
7 43.9 7 4 0 39.5 4.8 NA 0 NA 4.8 NA
8 44.6 NA NA 0 38.2 0 NA NA NA NA NA
9 43.5 1.3 1.8 0 39.5 4.4 NA NA NA 4.4 NA
10 44.5 NA NA 0 38.4 5.1 NA NA NA 5.1 NA
# ℹ 1,513 more rows
# ℹ 9 more variables: ICV <dbl>, EH <dbl>, EA <dbl>, OTROS <dbl>,
# type_survey <chr>, date_elec <date>, id_pollster <chr>, pollster <chr>,
# media <chr>
asociaciones <- list(
"PARTIDO SOCIALISTA OBRERO ESPAÑOL" = c(
"PARTIDO SOCIALISTA OBRERO ESPAÑOL",
"PARTIDO SOCIALISTA DE EUSKADI-EUSKADIKO EZKERRA",
"PARTIT DELS SOCIALISTES DE CATALUNYA",
"PARTIDO DOS SOCIALISTAS DE GALICIA-PSOE",
"PARTIDO SOCIALISTA DE EUSKADI-EUSKADIKO EZKERRA (PSOE)",
"PARTIDO DOS SOCIALISTAS DE GALICIA - PSOE",
"PARTIT DELS SOCIALISTES DE CATALUNYA (PSC-PSOE)",
"PARTIDO SOCIALISTA DE EUSKADI-EUSKADIKO EZKERRA(PSOE)",
"PARTIDO DOS SOCIALISTAS DE GALICIA-PARTIDO SOCIALISTA OBRERO ESPAÑOL",
"PARTIDO SOCIALISTA OBRERO ESPAÑOL DE ANDALUCIA",
"PARTIDO DOS SOCIALISTAS DE GALICIA - PARTIDO SOCIALISTA OBRERO ESPAÑOL",
"PARTIDO SOCIALISTA OBRERO ESPAÑOL-NUEVA CANARIAS"
),
"PARTIDO POPULAR" = c(
"PARTIDO POPULAR",
"PARTIT POPULAR/PARTIDO POPULAR",
"PARTIDO POPULAR/PARTIT POPULAR",
"PARTIDO POPULAR - FORO",
"UNION DEL PUEBLO NAVARRO EN COALICION CON EL PARTIDO POPULAR",
"NAVARRA SUMA", #Considero NA+ como PP
"PARTIDO POPULAR-EXTREMADURA UNIDA",
"PARTIDO POPULAR EN COALICIÓN CON EL PARTIDO ARAGONÉS",
"UNIÓN DEL PUEBLO NAVARRO EN COALICIÓN CON EL PARTIDO POPULAR",
"PARTIDO POPULAR (PP)",
"PARTIDO POPULAR EN COALICIÓN CON EL PARTIDO ARAGON",
"PARTIDO POPULAR-FORO",
"PARTIT POPULAR-PARTIDO POPULAR",
"PARTIDO POPULAR / PARTIT POPULAR"
),
"CIUDADANOS" = c(
"CIUDADANOS",
"CIUTADANS-PARTIDO DE LA CIUDADANIA",
"CIUDADANOS-PARTIDO DE LA CIUDADANIA",
"CIUDADANOS-PARTIDO DE LA CIUDADANÍA",
"CIUDADANOS PARTIDO DE LA CIUDADANÍA",
"CIUDADANOS-PARTIDO DE LA CIUDADANÍA (C's)",
"CIUDADANOS, PARTIDO DE LA CIUDADANÍA"
),
"EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO" = c(
"EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO",
"NAFARROA BAI",
"GEROA BAI"
),
"BLOQUE NACIONALISTA GALEGO" = c(
"BLOQUE NACIONALISTA GALEGO",
"BNG-NÓS CANDIDATURA GALEGA"
),
"UNIDAS PODEMOS" = c(
"UNIDAS PODEMOS",
"UNIDOS PODEMOS",
"PODEMOS",
"PODEM",
"IZQUIERDA UNIDA-ALTERNATIVA",
"EZKER BATUA-BERDEAK-ALTERNATIVA",
"IZQUIERDA UNIDA",
"ELKARREKIN PODEMOS",
"UNIDOS PODEMOS/ELKARREKIN AHAL DUGU",
"UNIDOS PODEMOS POR ANDALUCÍA",
"UNIDOS PODEMOS EN ALTO ARAGÓN",
"UNIDOS PODEMOS-ELKARREKIN AHAL DUGU",
"UNIDOS PODEMOS/XUNÍOS PODEMOS",
"UNIDOS PODEMOS EN ARAGÓN",
"ELKARREKIN PODEMOS-UNIDAS PODEMOS",
"UNIDAS PODEMOS-UNIDES PODEM",
"EN COMÚN-UNIDAS PODEMOS",
"UNIDAS PODEMOS-ALTOARAGÓN EN COMÚN",
"UNIDAS PODEMOS-XUNIES PODEMOS",
"UNIDAS PODEMOS-XUNÍES PODEMOS"
),
"ESQUERRA REPUBLICANA DE CATALUNYA" = c(
"ESQUERRA REPUBLICANA DE CATALUNYA",
"ESQUERRA REPUBLICANA/CATALUNYA SÍ"
),
"EUSKAL HERRIA BILDU" = c(
"EUSKAL HERRIA BILDU (EH Bildu)",
"EUSKAL HERRIA BILDU",
"EH - BILDU",
"SORTU",
"EUSKO ALKARTASUNA",
"ARALAR",
"ALTERNATIBA"
),
"VOX" = c("VOX")
)columnas_votos <- colnames(election_data)[16:ncol(election_data)] #Selecciona todas las columnas que contienen el nombre de cada partido y sus valores son el número de votos. 'columnas_votos' será un vector que contiene el nombre de todos los partidos disponibles de este dataset.
columnas_por_partido <- lapply(asociaciones, function(nombres){
intersect(nombres, columnas_votos)
}) #Para cada partido en la lista asociaciones, va recorriendo la lista 'asociaciones' aplicandole la función intersect. La cual recorre ambos vectores y devuelve las coincidencias. Así que el objeto 'columnas_por_partido' será una lista que va a contener los partidos de interés.
columnas_otros <- setdiff(columnas_votos, unlist(columnas_por_partido)) #identifica las columnas que están en columnas_votos pero no en columnas_por_partido
election_data_final <- election_data |>
mutate( #Crea nuevas columnas sumando los votos de las columnas asociadas a cada partido. Luego con rowSums, suma fila a fila los votos correspondientes.
`PARTIDO SOCIALISTA OBRERO ESPAÑOL` = rowSums(across(all_of(columnas_por_partido[["PARTIDO SOCIALISTA OBRERO ESPAÑOL"]])), na.rm = TRUE),
`PARTIDO POPULAR` = rowSums(across(all_of(columnas_por_partido[["PARTIDO POPULAR"]])), na.rm = TRUE),
`CIUDADANOS` = rowSums(across(all_of(columnas_por_partido[["CIUDADANOS"]])), na.rm = TRUE),
`EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO` = rowSums(across(all_of(columnas_por_partido[["EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO"]])), na.rm = TRUE),
`BLOQUE NACIONALISTA GALEGO` = rowSums(across(all_of(columnas_por_partido[["BLOQUE NACIONALISTA GALEGO"]])), na.rm = TRUE),
`UNIDAS PODEMOS` = rowSums(across(all_of(columnas_por_partido[["UNIDAS PODEMOS"]])), na.rm = TRUE),
`ESQUERRA REPUBLICANA DE CATALUNYA` = rowSums(across(all_of(columnas_por_partido[["ESQUERRA REPUBLICANA DE CATALUNYA"]])), na.rm = TRUE),
`EUSKAL HERRIA BILDU` = rowSums(across(all_of(columnas_por_partido[["EUSKAL HERRIA BILDU"]])), na.rm = TRUE),
`VOX` = rowSums(across(all_of(columnas_por_partido[["VOX"]])), na.rm = TRUE),
OTROS = rowSums(across(all_of(columnas_otros)), na.rm = TRUE)
) |>
select( # Reorganiza las columnas, colocando los partidos principales y OTROS después de las columnas descriptivas.
1:15,
`PARTIDO SOCIALISTA OBRERO ESPAÑOL`,
`PARTIDO POPULAR`,
`CIUDADANOS`,
`EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO`,
`BLOQUE NACIONALISTA GALEGO`,
`UNIDAS PODEMOS`,
`ESQUERRA REPUBLICANA DE CATALUNYA`,
`EUSKAL HERRIA BILDU`,
`VOX`,
OTROS
)# A tibble: 48,737 × 25
tipo_eleccion anno mes vuelta codigo_ccaa codigo_provincia
<chr> <dbl> <chr> <dbl> <chr> <chr>
1 02 2008 03 1 14 01
2 02 2008 03 1 14 01
3 02 2008 03 1 14 01
4 02 2008 03 1 14 01
5 02 2008 03 1 14 01
6 02 2008 03 1 14 01
7 02 2008 03 1 14 01
8 02 2008 03 1 14 01
9 02 2008 03 1 14 01
10 02 2008 03 1 14 01
# ℹ 48,727 more rows
# ℹ 19 more variables: codigo_municipio <chr>, codigo_distrito_electoral <dbl>,
# numero_mesas <dbl>, censo <dbl>, participacion_1 <dbl>,
# participacion_2 <dbl>, votos_blancos <dbl>, votos_nulos <dbl>,
# votos_candidaturas <dbl>, `PARTIDO SOCIALISTA OBRERO ESPAÑOL` <dbl>,
# `PARTIDO POPULAR` <dbl>, CIUDADANOS <dbl>,
# `EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO` <dbl>, …
Funcion para reemplazar los nombres de los partidos por sus correspondientes siglas:
abbrev_unico <- abbrev |>
group_by(denominacion) |>
filter(siglas != "PODEMOS-EUP") |>
filter(row_number() == 1) |> # Selecciona la primera fila para cada partido
ungroup()
reemplazar_por_siglas <- function(data, siglas, partidos) {
data |>
left_join(siglas, by = setNames("denominacion", partidos)) |>
mutate(
!!partidos:= ifelse(is.na(siglas), !!sym(partidos), siglas)) |>
select(-siglas) # Eliminar la columna de siglas
} resultado_ganador <- election_data_final |>
filter(censo > 100000) |> # Filtrar municipios con más de 100,000 habitantes
mutate( #Crea la columna ganador.
ganador = names(election_data_final)[15 + apply(across(16:ncol(election_data_final)), 1, which.max)], #Desde la columna 16 en adelante (columnas que corresponden a los partidos políticos) la función apply recorre cada fila y devuelve el nombre de la columna con el valor más alto, osea el partido con más votos.
#Con names(data)[15 + ...]: Convierte el índice en el nombre de la columna correspondiente (el nombre del partido ganador).
fecha = make_date(year = anno, month = mes)
) |>
group_by(fecha, ganador) |> # Agrupar por fecha y partido ganador
summarise(
total_municipios = n(), # Número de municipios ganados por cada partido
total_censo = sum(censo) # Suma del censo en municipios ganados
) |>
arrange(desc(total_municipios)) |> # Ordenar por número de municipios ganados
mutate(ganador = fct_reorder(ganador, total_municipios)) # Reordenar los niveles según total_municipios# A tibble: 24 × 4
# Groups: fecha [6]
fecha ganador total_municipios total_censo
<date> <chr> <int> <dbl>
1 2011-11-01 PP 39 9957740
2 2016-06-01 PP 36 9644439
3 2019-04-01 PSOE 34 9000055
4 2019-11-01 PSOE 32 6843354
5 2015-12-01 PP 30 8182716
6 2008-03-01 PSOE 24 5998571
7 2008-03-01 PP 23 6399108
8 2015-12-01 OTROS 13 3666524
9 2019-04-01 OTROS 9 2672967
10 2016-06-01 OTROS 7 2156174
# ℹ 14 more rows
resultado_ganador <- resultado_ganador |>
mutate(fecha_factor = factor(fecha, levels = unique(fecha))) # He creado la fecha a factor para que me salgan a la misma distancia porque si no las elecciones que se repiten se me juntaban mucho y no quedaba bonito ;)
# Gráfico de barras con partidos ganadores en municipios grandes por año
grafico1 <- ggplot(resultado_ganador) +
geom_col(aes(x = fecha_factor, y = total_municipios, fill = ganador), alpha = 0.8, position = "dodge2") +
scale_fill_manual(values = c("#4E8C48","#BDBDBD", "#6A4C93","#2DA7DE","#E63946","#5BC236")) +
scale_y_continuous(breaks = seq(0,60, by = 5)) +
labs(
title = "Partido Ganador en Municipios con más de 100.000 Habitantes",
x = "Partido",
y = "Número de Municipios Ganados",
fill = "Partidos Políticos:"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 25, size = 12, face = "bold", color = "grey30"),
legend.position = "bottom", panel.grid.minor.x = element_blank(), legend.text = element_text(size = 8))datos_largos <- election_data_final |>
pivot_longer(
cols = 16:ncol(election_data_final),
names_to = "partido", # Crear una columna con los nombres de los partidos
values_to = "votos" # Crear una columna con los votos
) |>
mutate(fecha = make_date(year = anno, month = mes))
datos_largos# A tibble: 487,370 × 18
tipo_eleccion anno mes vuelta codigo_ccaa codigo_provincia
<chr> <dbl> <chr> <dbl> <chr> <chr>
1 02 2008 03 1 14 01
2 02 2008 03 1 14 01
3 02 2008 03 1 14 01
4 02 2008 03 1 14 01
5 02 2008 03 1 14 01
6 02 2008 03 1 14 01
7 02 2008 03 1 14 01
8 02 2008 03 1 14 01
9 02 2008 03 1 14 01
10 02 2008 03 1 14 01
# ℹ 487,360 more rows
# ℹ 12 more variables: codigo_municipio <chr>, codigo_distrito_electoral <dbl>,
# numero_mesas <dbl>, censo <dbl>, participacion_1 <dbl>,
# participacion_2 <dbl>, votos_blancos <dbl>, votos_nulos <dbl>,
# votos_candidaturas <dbl>, partido <chr>, votos <dbl>, fecha <date>
datos_agrupados <- datos_largos |>
group_by(tipo_eleccion, fecha, vuelta, codigo_ccaa, codigo_provincia, codigo_municipio, partido) |>
summarise(votos = sum(votos, na.rm = TRUE), .groups = "drop")
head(datos_agrupados)# A tibble: 6 × 8
tipo_eleccion fecha vuelta codigo_ccaa codigo_provincia codigo_municipio
<chr> <date> <dbl> <chr> <chr> <chr>
1 02 2008-03-01 1 01 04 001
2 02 2008-03-01 1 01 04 001
3 02 2008-03-01 1 01 04 001
4 02 2008-03-01 1 01 04 001
5 02 2008-03-01 1 01 04 001
6 02 2008-03-01 1 01 04 001
# ℹ 2 more variables: partido <chr>, votos <dbl>
# llamamos a la función para reemplazar el nombre
datos_agrupados <- reemplazar_por_siglas(
data = datos_agrupados,
siglas = abbrev_unico,
partidos = "partido"
)
datos_agrupados# A tibble: 487,370 × 8
tipo_eleccion fecha vuelta codigo_ccaa codigo_provincia codigo_municipio
<chr> <date> <dbl> <chr> <chr> <chr>
1 02 2008-03-01 1 01 04 001
2 02 2008-03-01 1 01 04 001
3 02 2008-03-01 1 01 04 001
4 02 2008-03-01 1 01 04 001
5 02 2008-03-01 1 01 04 001
6 02 2008-03-01 1 01 04 001
7 02 2008-03-01 1 01 04 001
8 02 2008-03-01 1 01 04 001
9 02 2008-03-01 1 01 04 001
10 02 2008-03-01 1 01 04 001
# ℹ 487,360 more rows
# ℹ 2 more variables: partido <chr>, votos <dbl>
resultados_ordenados <- datos_agrupados |>
group_by(tipo_eleccion, fecha, vuelta, codigo_ccaa, codigo_provincia, codigo_municipio) |>
arrange(desc(votos)) |>
mutate(ranking = row_number()) |>
ungroup()
head(resultados_ordenados)# A tibble: 6 × 9
tipo_eleccion fecha vuelta codigo_ccaa codigo_provincia codigo_municipio
<chr> <date> <dbl> <chr> <chr> <chr>
1 02 2008-03-01 1 12 28 079
2 02 2011-11-01 1 12 28 079
3 02 2016-06-01 1 12 28 079
4 02 2008-03-01 1 12 28 079
5 02 2015-12-01 1 12 28 079
6 02 2015-12-01 1 09 08 019
# ℹ 3 more variables: partido <chr>, votos <dbl>, ranking <int>
# Filtrar y calcular el segundo partido
segundo_partido_municipios <- resultados_ordenados |>
filter(ranking <= 2) |>
group_by(tipo_eleccion, fecha, vuelta, codigo_ccaa, codigo_provincia, codigo_municipio) |>
mutate(primer_partido = partido[ranking == 1]) |>
filter(primer_partido %in% c("PSOE", "PP") & ranking == 2) |>
ungroup()
# Contar el número de municipios para cada combinación de primer y segundo partido
segundo_partido_municipios_grouped <- segundo_partido_municipios |>
group_by(fecha, primer_partido, partido) |>
summarise(frecuencia = n_distinct(codigo_municipio), .groups = "drop")# Crear estructura jerárquica para el gráfico
segundo_partido_municipios_grouped$pathString <- paste(
"Resultados",
format(segundo_partido_municipios_grouped$fecha, "%Y-%m"),
segundo_partido_municipios_grouped$primer_partido,
segundo_partido_municipios_grouped$partido,
sep = "/"
)
# Crear un nodo jerárquico
arbol_datos_municipios <- as.Node(segundo_partido_municipios_grouped)
# Generar el gráfico
grafico_circulos <- circlepackeR(
arbol_datos_municipios,
size = "frecuencia",
color_min = "hsl(412,80%,80%)",
color_max = "hsl(228,30%,40%)",
width = NULL,
height = NULL
)tabla_resultados <- datos_largos |>
group_by(anno, mes, partido) |>
summarise(votos_totales = sum(votos, na.rm = TRUE), .groups = "drop") |>
arrange(anno, mes, desc(votos_totales)) |> # Ordenar por año, mes y votos en orden descendente
group_by(anno, mes) |>
slice_head(n = 3) |> # Seleccionar los tres partidos con más votos en cada elección
mutate(ranking = row_number()) |> # Añadir ranking: 1 = primer partido, 2 = segundo, etc.
pivot_wider(
names_from = ranking,
values_from = c(partido, votos_totales),
names_glue = "Posicion_{.value}_{ranking}" # Renombrar columnas
) |>
arrange(anno, mes) # Ordenar por año y mes
tabla_resultados# A tibble: 6 × 8
# Groups: anno, mes [6]
anno mes Posicion_partido_1 Posicion_partido_2 Posicion_partido_3
<dbl> <chr> <chr> <chr> <chr>
1 2008 03 PARTIDO SOCIALISTA OBRERO E… PARTIDO POPULAR OTROS
2 2011 11 PARTIDO POPULAR PARTIDO SOCIALIST… OTROS
3 2015 12 PARTIDO POPULAR OTROS PARTIDO SOCIALIST…
4 2016 06 PARTIDO POPULAR PARTIDO SOCIALIST… OTROS
5 2019 04 PARTIDO SOCIALISTA OBRERO E… PARTIDO POPULAR OTROS
6 2019 11 PARTIDO SOCIALISTA OBRERO E… PARTIDO POPULAR VOX
# ℹ 3 more variables: Posicion_votos_totales_1 <dbl>,
# Posicion_votos_totales_2 <dbl>, Posicion_votos_totales_3 <dbl>
obtener_segundo_partido <- function(ccaa, provincia, municipio, fecha) {
# Filtrar los resultados para el municipio, fecha, ccaa y provincia deseada
resultados_municipio <- datos_largos |>
filter(
as.integer(codigo_ccaa) == ccaa,
as.integer(codigo_provincia) == provincia,
as.integer(codigo_municipio) == municipio,
fecha == fecha
)
# Primero verificamos que haya un resultado disponible
if (nrow(resultados_municipio) == 0) {
return(glue("No hay resultados disponibles para el municipio con código {municipio}, fecha {fecha}, comunidad autónoma {ccaa} y provincia {provincia}."))
}
# Ordenar por votos y calcular el ranking
resultados_ordenados <- resultados_municipio |>
arrange(desc(votos)) |>
mutate(ranking = row_number())
# Obtenemos los partidos
primer_partido <- resultados_ordenados$partido[resultados_ordenados$ranking == 1]
segundo_partido <- resultados_ordenados$partido[resultados_ordenados$ranking == 2]
# Verificar si hay un segundo partido
if (is.na(segundo_partido)) {
return(glue("En el municipio con código {municipio}, fecha {fecha}, comunidad autónoma {ccaa} y provincia {provincia}, el primer partido fue {primer_partido}, pero no hay información sobre el segundo partido."))
}
# Formateamos la respuesta con glue
respuesta <- glue(
"En el municipio introducido, el {fecha}, el primer partido fue {primer_partido} y el segundo partido fue {segundo_partido}. "
)
return(respuesta)
}Ejemplos:
En el municipio introducido, el 2008-03-01, el primer partido fue PARTIDO SOCIALISTA OBRERO ESPAÑOL y el segundo partido fue PARTIDO POPULAR.
# Este ejemplo corresponde a Añora, municipio de Córdoba en Andalucía
obtener_segundo_partido(1, 29, 67, "2019-04-01")En el municipio introducido, el 2019-04-01, el primer partido fue PARTIDO POPULAR y el segundo partido fue PARTIDO SOCIALISTA OBRERO ESPAÑOL.
Para responder a la pregunta vamos a hacer lo siguiente: Calcular y comparar el error entre los resultados estimados por las encuestas y los resultados reales de las elecciones a nivel nacional, tanto en términos absolutos como porcentuales.
Primero se suman todos los votos para que sea a nivel nacional y no desagregado por comunidad autónoma, provincia y municipio.
election_data_nacional <- election_data_final |>
mutate(fecha_eleccion = as.character(glue("{anno}-{mes}"))) |> #Con esto creamos la variable en base a la cual vamos a sumar por grupos, y además luego sirve como clave para hacer el join y utilizamos la función glue que hacía falta
group_by(fecha_eleccion) |> #Agrupamos como decía
summarise(
across( # Sumamos los votos de cada partido por fecha
c("PARTIDO SOCIALISTA OBRERO ESPAÑOL", "PARTIDO POPULAR", "CIUDADANOS",
"EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO", "BLOQUE NACIONALISTA GALEGO",
"UNIDAS PODEMOS", "ESQUERRA REPUBLICANA DE CATALUNYA",
"EUSKAL HERRIA BILDU", "VOX", "OTROS"),
~sum(.x, na.rm = TRUE)
)
) |>
mutate( #Creamos la variable del total de votos en cada elección porque después hay crear la variable que represente el porcentaje de votos, no el número de votos. Porque como decía antes está así en surveys_select
total_votos = rowSums(across(c("PARTIDO SOCIALISTA OBRERO ESPAÑOL", "PARTIDO POPULAR", "CIUDADANOS",
"EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO",
"BLOQUE NACIONALISTA GALEGO","UNIDAS PODEMOS",
"ESQUERRA REPUBLICANA DE CATALUNYA","EUSKAL HERRIA BILDU", "VOX",
"OTROS")), na.rm = TRUE)
) |>
arrange(fecha_eleccion) #Ordenamos por fecha de elección (no es necesario del todo pero queda mejor)
election_data_nacional# A tibble: 6 × 12
fecha_eleccion PARTIDO SOCIALISTA OBRERO ESPAÑO…¹ `PARTIDO POPULAR` CIUDADANOS
<chr> <dbl> <dbl> <dbl>
1 2008-03 11071649 10171828 45027
2 2011-11 6975407 10838951 0
3 2015-12 5368954 7114123 3081521
4 2016-06 5424130 7800328 2745006
5 2019-04 6567587 4463826 4031767
6 2019-11 6752314 5120072 1421024
# ℹ abbreviated name: ¹`PARTIDO SOCIALISTA OBRERO ESPAÑOL`
# ℹ 8 more variables:
# `EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO` <dbl>,
# `BLOQUE NACIONALISTA GALEGO` <dbl>, `UNIDAS PODEMOS` <dbl>,
# `ESQUERRA REPUBLICANA DE CATALUNYA` <dbl>, `EUSKAL HERRIA BILDU` <dbl>,
# VOX <dbl>, OTROS <dbl>, total_votos <dbl>
Renombro los partidos con sus siglas para que encaje con surveys
# Crear un diccionario para mapear nombres largos a siglas
partido_siglas <- c(
"PARTIDO SOCIALISTA OBRERO ESPAÑOL" = "PSOE",
"PARTIDO POPULAR" = "PP",
"CIUDADANOS" = "CS",
"EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO" = "EAJ-PNV",
"BLOQUE NACIONALISTA GALEGO" = "BNG",
"UNIDAS PODEMOS" = "PODEMOS",
"ESQUERRA REPUBLICANA DE CATALUNYA" = "ERC",
"EUSKAL HERRIA BILDU" = "EH-BILDU",
"VOX" = "VOX",
"OTROS" = "OTROS"
)
# Renombrar las columnas usando el diccionario
election_data_nacional <- election_data_nacional |>
rename_with(~ partido_siglas[.x], .cols = names(partido_siglas))
# Mostrar el resultado
election_data_nacional# A tibble: 6 × 12
fecha_eleccion PSOE PP CS `EAJ-PNV` BNG PODEMOS ERC `EH-BILDU`
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 2008-03 1.11e7 1.02e7 4.50e4 365337 209434 180920 289641 62644
2 2011-11 6.98e6 1.08e7 0 365956 183245 0 0 0
3 2015-12 5.37e6 7.11e6 3.08e6 332144 0 2844096 0 218453
4 2016-06 5.42e6 7.80e6 2.75e6 300476 44902 3084740 629269 184074
5 2019-04 6.57e6 4.46e6 4.03e6 416893 93813 3118375 0 258848
6 2019-11 6.75e6 5.12e6 1.42e6 390124 119597 2550852 0 276535
# ℹ 3 more variables: VOX <dbl>, OTROS <dbl>, total_votos <dbl>
Ahora con esto creamos la variable porcentaje:
# Calcular porcentajes, redondear a 1 decimal y mantener solo columnas de porcentaje
election_data_nacional <- election_data_nacional |>
mutate(
across(
c(PSOE, PP, CS, `EAJ-PNV`, BNG, PODEMOS, ERC, `EH-BILDU`, VOX, OTROS),
~ round((.x / total_votos) * 100, 1),
.names = "pct_{.col}"
)
) |>
select(fecha_eleccion, starts_with("pct_"))
election_data_nacional# A tibble: 6 × 11
fecha_eleccion pct_PSOE pct_PP pct_CS `pct_EAJ-PNV` pct_BNG pct_PODEMOS
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 2008-03 44.2 40.6 0.2 1.5 0.8 0.7
2 2011-11 29.2 45.3 0 1.5 0.8 0
3 2015-12 21.6 28.6 12.4 1.3 0 11.4
4 2016-06 22.8 32.8 11.6 1.3 0.2 13
5 2019-04 25.4 17.2 15.6 1.6 0.4 12.1
6 2019-11 28.3 21.5 6 1.6 0.5 10.7
# ℹ 4 more variables: pct_ERC <dbl>, `pct_EH-BILDU` <dbl>, pct_VOX <dbl>,
# pct_OTROS <dbl>
surveys_select <- surveys_filtered |>
select(-type_survey) |>
mutate( fecha_eleccion = as.character( glue("{year(date_elec)}-{sprintf('%02d', month(date_elec))}") ) ) |> #Creamos la variable fecha igual que la otra para unir mediante esta clave. Lo de sprint hace falta para que coincida con la otra clave
select(-date_elec) #Ahora esta sobra
surveys_select# A tibble: 1,523 × 19
PSOE `EAJ-PNV` ERC `EH-BILDU` PP PODEMOS CS BNG VOX IU PCE
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 43 6 5 0 39 3 NA NA NA 3 NA
2 42.6 6 5 0 38.6 4 NA NA NA 4 NA
3 42.4 6 5 0 39 4 NA NA NA 4 NA
4 44.1 NA 4 0 38 5.2 NA NA NA 5.2 NA
5 44.3 NA NA 0 38 0 NA NA NA NA NA
6 43.4 1.5 1.9 0 39.3 4.4 NA 0.6 NA 4.4 NA
7 43.9 7 4 0 39.5 4.8 NA 0 NA 4.8 NA
8 44.6 NA NA 0 38.2 0 NA NA NA NA NA
9 43.5 1.3 1.8 0 39.5 4.4 NA NA NA 4.4 NA
10 44.5 NA NA 0 38.4 5.1 NA NA NA 5.1 NA
# ℹ 1,513 more rows
# ℹ 8 more variables: ICV <dbl>, EH <dbl>, EA <dbl>, OTROS <dbl>,
# id_pollster <chr>, pollster <chr>, media <chr>, fecha_eleccion <chr>
Ahora que tenemos todo se realiza el join y se calcula el error para cada estimacion diferente hecha (restando obs en valor absoluto).
error_encuestas <- surveys_select |>
#Realizar el join entre surveys_select y election_data_nacional
left_join(election_data_nacional, by = "fecha_eleccion") |>
mutate(
across(
c(PSOE, PP, CS, `EAJ-PNV`, BNG, PODEMOS, ERC, `EH-BILDU`, VOX, OTROS), #Con esto seleccionas estas columnas.
~ abs(.x - get(paste0("pct_", cur_column()))), #Con la fila de arriba vas a ir recorriendo todo ese vector entonces '.x' rerpesenta la columan actual. Luego con el get busca en el dataset lo de dentro de los parantesis y devuelve sus valores. Con paste0("pct_", cur_column())) lo que haces es que a la columna actual (current column con cur_column) le pegas el prefijo pct_ que es como he llamado al valor real del porcentaje de voto a ese partido. Entonces al restar esos dos valores y hacer su valor absoluto, estamos calculando el error.
.names = "error_abs_{.col}" #Ese cálculo para cada partido se va a llamar error_abs_partido_correspondiente.
)
)
error_encuestas# A tibble: 1,523 × 39
PSOE `EAJ-PNV` ERC `EH-BILDU` PP PODEMOS CS BNG VOX IU PCE
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 43 6 5 0 39 3 NA NA NA 3 NA
2 42.6 6 5 0 38.6 4 NA NA NA 4 NA
3 42.4 6 5 0 39 4 NA NA NA 4 NA
4 44.1 NA 4 0 38 5.2 NA NA NA 5.2 NA
5 44.3 NA NA 0 38 0 NA NA NA NA NA
6 43.4 1.5 1.9 0 39.3 4.4 NA 0.6 NA 4.4 NA
7 43.9 7 4 0 39.5 4.8 NA 0 NA 4.8 NA
8 44.6 NA NA 0 38.2 0 NA NA NA NA NA
9 43.5 1.3 1.8 0 39.5 4.4 NA NA NA 4.4 NA
10 44.5 NA NA 0 38.4 5.1 NA NA NA 5.1 NA
# ℹ 1,513 more rows
# ℹ 28 more variables: ICV <dbl>, EH <dbl>, EA <dbl>, OTROS <dbl>,
# id_pollster <chr>, pollster <chr>, media <chr>, fecha_eleccion <chr>,
# pct_PSOE <dbl>, pct_PP <dbl>, pct_CS <dbl>, `pct_EAJ-PNV` <dbl>,
# pct_BNG <dbl>, pct_PODEMOS <dbl>, pct_ERC <dbl>, `pct_EH-BILDU` <dbl>,
# pct_VOX <dbl>, pct_OTROS <dbl>, error_abs_PSOE <dbl>, error_abs_PP <dbl>,
# error_abs_CS <dbl>, `error_abs_EAJ-PNV` <dbl>, error_abs_BNG <dbl>, …
Ahora calculamos el error medio por elecciones celebradas y por partido haciendo la media del error para cada una de ellas (identificada con la variable fecha_eleccion) y para cada partido.
# Calcular el error absoluto medio por partido para cada elección
error_medio_partido_fecha <- error_encuestas |>
group_by(fecha_eleccion)|> #Hacemos los cálculos por elecciones
summarise(across( #Función para recorrer las columnas.
starts_with("error_abs_"), #Seleccionamos las columnas que empiecen por error_abs_ que es de las que queremos hacer la media.
~ if (all(is.na(.x))) NA else mean(.x, na.rm = TRUE), #Hay columnas que son todo missing, entonces para que no haga la media sobre eso y la haga para los que si hay algún valor e ignorando los missing.
.names = "mean_{.col}"))|>
pivot_longer( #Ponemos el dataset en formato largo para el gráfico y porque se ve mejor así.
cols = -fecha_eleccion, #Pivotamos todas menos la variable fecha_eleccion
names_to = "partido", #Los nombres de las columnas de las cols pivotadas van a estar en esta variable.
names_prefix = "mean_error_abs_", #Elimina ese prefijo para que quede solo el nombre del partido.
values_to = "error_abs_medio" #Los valores calculados van a esta variable.
)
error_medio_partido_fecha# A tibble: 60 × 3
fecha_eleccion partido error_abs_medio
<chr> <chr> <dbl>
1 2008-03 PSOE 2.17
2 2008-03 PP 2.31
3 2008-03 CS NA
4 2008-03 EAJ-PNV 0.368
5 2008-03 BNG 0.483
6 2008-03 PODEMOS 3.72
7 2008-03 ERC 1.14
8 2008-03 EH-BILDU 0.2
9 2008-03 VOX NA
10 2008-03 OTROS 8.48
# ℹ 50 more rows
#Cada partido con su color de campaña.
colores_partidos <- c(
"PSOE" = "#E63946",
"PP" = "#2DA7DE",
"CS" = "#F77F00",
"EAJ-PNV" = "#4E8C48",
"BNG" = "#8AB17D",
"PODEMOS" = "#6A4C93",
"ERC" = "#FFDD00",
"EH-BILDU" = "#2A9D8F",
"VOX" = "#5BC236",
"OTROS" = "#BDBDBD"
)
grafica3 <- ggplot(error_medio_partido_fecha, aes(x = fecha_eleccion, y = error_abs_medio, fill = partido)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_manual(values = colores_partidos) + # Aplicar colores personalizados
labs(
title = "Error Medio Absoluto por Partido y Fecha de Elección",
x = "Fecha de Elección",
y = "Error Medio Absoluto",
fill = "Partido"
) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom"
)Primero calculamos cuál es el partido ganador en cada municipio (que es el nivel más bajo de agregacion después de comunidad autónoma y provincia)
election_data_final2 <- election_data_final |>
mutate(
partido_ganador = apply(
select(election_data_final, "PARTIDO SOCIALISTA OBRERO ESPAÑOL", "PARTIDO POPULAR",
"CIUDADANOS", "EUZKO ALDERDI JELTZALEA-PARTIDO NACIONALISTA VASCO",
"BLOQUE NACIONALISTA GALEGO","UNIDAS PODEMOS", "ESQUERRA REPUBLICANA DE CATALUNYA",
"EUSKAL HERRIA BILDU", "VOX", "OTROS"),
1, function(row) names(row)[which.max(row)])
)Después categorizamos la variable censo en 2 categorías Rural, y Urbana, en base al criterio del INE que son 10.000 habitantes. Esta variable va a hacer falta para el gráfico y el contraste que vienen a continuación.
#llamamos a la función para reemplazar los nombres por siglas:
election_data_final2 <- reemplazar_por_siglas(
data = election_data_final2,
siglas = abbrev_unico,
partidos = "partido_ganador"
)
colores_partidos <- c(
"PSOE" = "#E63946",
"PP" = "#2DA7DE",
"CS" = "#F77F00",
"EAJ-PNV" = "#4E8C48",
"BNG" = "#8AB17D",
"PODEMOS-IU" = "#6A4C93",
"ERC" = "#FFDD00",
"EH Bildu" = "#2A9D8F",
"VOX" = "#5BC236",
"OTROS" = "#BDBDBD"
)
# Gráfico con los colores específicos
grafico4 <- ggplot(election_data_final2, aes(x = categoria_censo, fill = partido_ganador)) +
geom_bar(position = "fill") +
scale_fill_manual(
values = colores_partidos,
breaks = names(colores_partidos) # Ordenar los colores según la lista
) +
labs(
title = "Distribución del Partido Ganador por Categoría de Censo",
x = "Categoría de Censo",
y = "Proporción",
fill = "Partido Ganador"
) +
theme_minimal() +
theme(
axis.text.x = element_text(hjust = 1),
legend.position = "bottom"
)tabla_contingencia <- table(election_data_final2$categoria_censo, election_data_final2$partido_ganador)
tabla_contingencia
BNG CIUDADANOS EAJ-PNV EH Bildu ERC OTROS PODEMOS-IU PP PSOE
Rural 6 128 761 524 53 6042 378 23920 13142
Urbana 0 13 74 8 0 710 48 1397 1183
VOX
Rural 306
Urbana 44
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: tabla_contingencia
p-value = 1e-05
alternative hypothesis: two.sided
H0: La categoría de censo (Rural/Urbana) y el partido ganador son independientes. Es decir, el partido ganador no depende de si la zona es rural o urbana. H1: Hay asociación entre la categoría de censo y el partido ganador. Es decir, el partido ganador sí depende de si la zona es rural o urbana.
Con el objetivo de analizar la base de datos de “election_data”, se plantea elegir una provincia con heterogeneidad de partidos políticos, Navarra.
Esto se realiza sin intenciones políticas, sino con el objetivo de presentar un análisis de los datos electorales en una provincia específica diferente.
Se obtendrá el partido político ganador de cada municipio y se representará. Para ello, se seleccionarán los datos correspondientes a estos años y se compararán los resultados de los partidos políticos de interés en este ejercicio.
Se utiliza un mapa de municipios descargado de https://geoportal.navarra.es/es/ para graficar los resultados
shapefile <- "DIADMI_Pol_Municipio/DIADMI_Pol_Municipio.shp"
municipios_navarra <- st_read(shapefile)Reading layer `DIADMI_Pol_Municipio' from data source
`/Users/nataliasanchezsantos/Desktop/MASTER/R/DIADMI_Pol_Municipio/DIADMI_Pol_Municipio.shp'
using driver `ESRI Shapefile'
Simple feature collection with 272 features and 28 fields
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: 541085.6 ymin: 4640789 xmax: 685574.1 ymax: 4796617
Projected CRS: ETRS89 / UTM zone 30N
# Elecciones de 2008 (abril)
navarra_2008 <- election_data_final |>
filter(anno == 2008 & codigo_provincia == "31") |>
mutate(cod_mun = paste("13", "31", codigo_municipio, sep = "-")) |>
left_join(cod_mun, by = "cod_mun")
# Elecciones de 2019 (abril)
navarra_2019_abril <- election_data_final |>
filter(anno == 2019 & mes == "04" & codigo_provincia == "31") |>
mutate(cod_mun = paste("13", "31", codigo_municipio, sep = "-")) |>
left_join(cod_mun, by = "cod_mun")Para ello, se realizan los siguientes pasos clave:
procesar_elecciones <- function(data, municipios) {
# Paso 1: Calcular el partido ganador
data_procesado <- data |>
rowwise() |>
mutate(
partido_ganador = {
valores <- c_across(16:25) # Selección por índices de columnas de partidos
nombres <- colnames(data)[16:25]
max_votos <- max(valores, na.rm = TRUE)
if (all(valores == 0, na.rm = TRUE)) {
"Sin datos"
} else if (sum(valores == max_votos, na.rm = TRUE) > 1) {
"Municipios con empate"
} else {
nombres[which.max(valores)]
}
}
) |>
ungroup()
# Paso 2: Unir los datos geoespaciales y corregir nombres de municipios
mapa_final <- municipios |>
mutate(MUNICIPIO = tolower(MUNICIPIO)) |>
left_join(
data_procesado |>
mutate(
municipio = tolower(municipio),
municipio = gsub("/", " / ", municipio),
municipio = case_when(
municipio == "romanzado" ~ "romanzado / erromantzatua",
municipio == "urraul alto" ~ "urraúl alto",
municipio == "urraul bajo" ~ "urraúl bajo",
municipio == "arcos, los" ~ "los arcos",
municipio == "busto, el" ~ "el busto",
municipio == "pueyo" ~ "pueyo / puiu",
municipio == "ucar" ~ "úcar",
municipio == "atez / atetz" ~ "atetz",
municipio == "olaibar" ~ "oláibar",
municipio == "juslapeña" ~ "juslapeña / txulapain",
municipio == "lizoáin-arriasgoiti" ~ "lizoain-arriasgoiti / lizoainibar-arriasgoiti",
municipio == "saldías" ~ "saldias",
TRUE ~ municipio
)
),
by = c("MUNICIPIO" = "municipio")
)
# Devolver el resultado
return(mapa_final)
}Aplicamos la función:
Aplicamos la función de reemplazar los nombres por siglas:
# Actualización de los colores
colores <- c(
"Otros" = "grey70",
"PP" = "#00ADE0",
"PSOE" = "#D21B00",
"EAJ-PNV" = "#007A45",
"EH Bildu" = "#00C19F",
"PODEMOS-IU" = "#6C00A4",
"Municipios con empate" = "yellow"
)
# Crear un único DataFrame para los dos años
mapa_combined <- bind_rows(
mapa_navarra_2008 |> mutate(año = "2008"),
mapa_navarra_2019 |> mutate(año = "2019")
)
# Crear el gráfico con facetas para cada año
grafico_navarra <- ggplot(mapa_combined) +
geom_sf(aes(fill = partido_ganador), color = "black", size = 0.2) +
scale_fill_manual(values = colores, na.value = "grey80") +
facet_wrap(~año, ncol = 2) +
labs(
title = "NAVARRA",
fill = "Partido Ganador"
) +
theme_minimal() +
theme(
legend.position = "bottom",
legend.text = element_text(size = 8), # Ajustar tamaño del texto de la leyenda
legend.title = element_text(size = 10, face = "bold"),
plot.title = element_text(size = 16, face = "bold"),
plot.subtitle = element_text(size = 12),
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank()
)# Calcular el porcentaje de participación para 2008
mapa_navarra_2008 <- mapa_navarra_2008 |>
mutate(
porcentaje_participacion = (participacion_2 / censo) * 100 # Calcula el porcentaje
)
# Calcular el porcentaje de participación para 2019
mapa_navarra_2019 <- mapa_navarra_2019 |>
mutate(
porcentaje_participacion = (participacion_2 / censo) * 100 # Calcula el porcentaje
)# Crear un único DataFrame para los dos años con la columna "año"
mapa_combined <- bind_rows(
mapa_navarra_2008 |> mutate(año = "2008"),
mapa_navarra_2019 |> mutate(año = "2019")
)
grafico_navarra2 <- ggplot(mapa_combined) +
geom_sf(aes(fill = porcentaje_participacion), color = "black", size = 0.2) +
scale_fill_gradientn(
colors = c("#f7fbff", "#ADD8E6", "#1E90FF", "#000080"), # Gradiente azul con más contraste
values = scales::rescale(c(0, 30, 70, 100)), # Ajusta la intensidad de los colores
na.value = "grey80",
name = "Participación (%)"
) +
facet_wrap(~año, ncol = 2) +
labs(
title = "Participación Electoral por Municipio",
subtitle = "Porcentaje de participación final en las elecciones (2008 vs 2019)",
fill = "Participación (%)"
) +
theme_minimal() +
theme(
legend.position = "bottom",
plot.title = element_text(size = 16, face = "bold"),
plot.subtitle = element_text(size = 12),
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank()
)wilcox.test(mapa_navarra_2008$porcentaje_participacion, mapa_navarra_2019$porcentaje_participacion, alternative = "less")
Wilcoxon rank sum test with continuity correction
data: mapa_navarra_2008$porcentaje_participacion and mapa_navarra_2019$porcentaje_participacion
W = 31375, p-value = 0.001092
alternative hypothesis: true location shift is less than 0
¿Tendrá la población mayor inquietud política con el paso de los años?